perm filename CROP.SAI[PIC,HE] blob
sn#430355 filedate 1979-04-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY CROP,CROPPL
C00004 ENDMK
C⊗;
ENTRY CROP,CROPPL;
BEGIN "CROP"
REQUIRE "BUFDEC" SOURCE!FILE;
INTERNAL SIMPLE INTEGER PROCEDURE CROP(INTEGER BUFF,SI,EI,SJ,EJ);
BEGIN "CROPX"
INTEGER I,J,PTR,OPTR,OBUF,SAV;
SAV←1;
GETBUF(EI-SI+1,EJ-SJ+1,BYTSZ(BUFF),OBUF←FNDBUF);
PUTSUB(ISUBST(BUFF)+SI-1,JSUBST(BUFF)+SJ-1,OBUF);
COPHDR(BUFF,OBUF);
FOR I←SI STEP 1 UNTIL EI DO
BEGIN
PTR←INPTR(I,SJ,BUFF);
OPTR←OUTPTR(SAV,1,OBUF);
FOR J←SJ STEP 1 UNTIL EJ DO
IDPB(ILDB(PTR),OPTR);
SAV←SAV+1;
ROWCHK(CHKROW,ROWS,SAV,50);
END;
RETURN(OBUF);
END "CROPX";
INTERNAL PROCEDURE CROPPL(INTEGER BUFF,OBUF,SI,EI,SJ,EJ,PI,PJ);
BEGIN "CROPPL"
INTEGER I,J,PTR,OPTR,SAVPI,tmp;
SAVPI←PI;
FOR I←SI STEP 1 UNTIL EI DO
BEGIN
PTR←INPTR(I,SJ,BUFF);
OPTR←OUTPTR(SAVPI,PJ,OBUF);
FOR J←SJ STEP 1 UNTIL EJ DO
COMMENT if tmp←ildb(ptr) then idpb(tmp,optr) else ibp(optr);
IDPB(ILDB(PTR),OPTR);
SAVPI←SAVPI+1;
END;
END "CROPPL";
END "CROP";